home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / FSTRANL.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  6.8 KB  |  266 lines
  1. /*
  2.  * File: fstranl.r
  3.  * String analysis functions: any,bal,find,many,match,upto
  4.  *
  5.  * str_anal is a macro for performing the standard conversions and
  6.  *  defaulting for string analysis functions. It takes as arguments the
  7.  *  parameters for subject, beginning position, and ending position. It
  8.  *  produces declarations for these 3 names prepended with cnv_. These
  9.  *  variables will contain the converted versions of the arguments.
  10.  *
  11.  * Originated by kwalker 6/27/89.  Enhanced/revised by cjeffery
  12.  */
  13. #begdef str_anal(s, i, j)
  14.    declare {
  15.       C_integer cnv_ ## i;
  16.       C_integer cnv_ ## j;
  17.       }
  18.  
  19.    abstract {
  20.       return integer
  21.       }
  22.    
  23.    if is:null(s) then {
  24.       inline {
  25.          s = k_subject;
  26.          }
  27.       if is:null(i) then inline {
  28.          cnv_ ## i = k_pos;
  29.          }
  30.       }
  31.    else {
  32.       if !cnv:string(s) then
  33.          runerr(103,s)
  34.       if is:null(i) then inline {
  35.          cnv_ ## i = 1;
  36.          }
  37.       }
  38.  
  39.    if !is:null(i) then
  40.       if cnv:C_integer(i,cnv_ ## i) then inline {
  41.          if ((cnv_ ## i = cvpos(cnv_ ## i, StrLen(s))) == CvtFail)
  42.             fail;
  43.          }
  44.       else
  45.          runerr(101,i)
  46.  
  47.  
  48.     if is:null(j) then inline {
  49.        cnv_ ## j = StrLen(s) + 1;
  50.        }
  51.     else if cnv:C_integer(j,cnv_ ## j) then inline {
  52.        if ((cnv_ ## j = cvpos(cnv_ ## j, StrLen(s))) == CvtFail)
  53.           fail;
  54.        if (cnv_ ## i > cnv_ ## j) {
  55.           register C_integer tmp;
  56.           tmp = cnv_ ## i;
  57.           cnv_ ## i = cnv_ ## j;
  58.           cnv_ ## j = tmp;
  59.           }
  60.        }
  61.     else
  62.        runerr(101,j)
  63.  
  64. #enddef
  65.  
  66.  
  67. "any(c,s,i1,i2) - produces i1+1 if i2 is greater than 1 and s[i] is contained "
  68. "in c and poseq(i2,x) is greater than poseq(i1,x), but fails otherwise."
  69.  
  70. function{0,1} any(c,s,i,j)
  71.    str_anal( s, i, j )
  72.    if !cnv:tmp_cset(c) then
  73.       runerr(104,c)
  74.    body {
  75.       if (cnv_i == cnv_j)
  76.          fail;
  77.       if (!Testb(StrLoc(s)[cnv_i-1], c))
  78.          fail;
  79.       return C_integer cnv_i+1;
  80.       }
  81. end
  82.  
  83.  
  84. "bal(c1,c2,c3,s,i1,i2) - generates the sequence of integer positions in s up to"
  85. " a character of c1 in s[i1:i2] that is balanced with respect to characters in"
  86. " c2 and c3, but fails if there is no such position."
  87.  
  88. function{*} bal(c1,c2,c3,s,i,j)
  89.    str_anal( s, i, j )
  90.    if !def:tmp_cset(c1,fullcs) then
  91.       runerr(104,c1)
  92.    if !def:tmp_cset(c2,lparcs) then
  93.       runerr(104,c2)
  94.    if !def:tmp_cset(c3,rparcs) then
  95.       runerr(104,c3)
  96.  
  97.    body {
  98.       C_integer cnt;
  99.       char c;
  100.  
  101.       /*
  102.        * Loop through characters in s[i:j].  When a character in c2
  103.        * is found, increment cnt; when a character in c3 is found, decrement
  104.        * cnt.  When cnt is 0 there have been an equal number of occurrences
  105.        * of characters in c2 and c3, i.e., the string to the left of
  106.        * i is balanced.  If the string is balanced and the current character
  107.        * (s[i]) is in c, suspend with i.  Note that if cnt drops below
  108.        *  zero, bal fails.
  109.        */
  110.       cnt = 0;
  111.       while (cnv_i < cnv_j) {
  112.          c = ToAscii(StrLoc(s)[cnv_i-1]);
  113.          if (cnt == 0 && Testb(c, c1)) {
  114.             suspend C_integer cnv_i;
  115.             }
  116.          if (Testb(c, c2))
  117.             cnt++;
  118.          else if (Testb(c, c3))
  119.             cnt--;
  120.          if (cnt < 0)
  121.             fail;
  122.          cnv_i++;
  123.          }
  124.       /*
  125.        * Eventually fail.
  126.        */
  127.       fail;
  128.       }
  129. end
  130.  
  131.  
  132. "find(s1,s2,i1,i2) - generates the sequence of positions in s2 at which "
  133. "s1 occurs as a substring in s2[i1:i2], but fails if there is no such position."
  134.  
  135. function{*} find(s1,s2,i,j)
  136.    str_anal( s2, i, j )
  137.    if !cnv:string(s1) then
  138.       runerr(103,s1)
  139.  
  140.    body {
  141.       register char *str1, *str2;
  142.       C_integer s1_len, l, term;
  143.  
  144.       /*
  145.        * Loop through s2[i:j] trying to find s1 at each point, stopping
  146.        * when the remaining portion s2[i:j] is too short to contain s1.
  147.        * Optimize me!
  148.        */
  149.       s1_len = StrLen(s1);
  150.       term = cnv_j - s1_len;
  151.       while (cnv_i <= term) {
  152.          str1 = StrLoc(s1);
  153.          str2 = StrLoc(s2) + cnv_i - 1;
  154.          l    = s1_len;
  155.  
  156.          /*
  157.           * Compare strings on a byte-wise basis; if the end is reached
  158.           * before inequality is found, suspend with the position of the
  159.           * string.
  160.           */
  161.          do {
  162.             if (l-- <= 0) {
  163.                suspend C_integer cnv_i;
  164.                break;
  165.                }
  166.             } while (*str1++ == *str2++);
  167.          cnv_i++;
  168.          }
  169.       fail;
  170.       }
  171. end
  172.  
  173.  
  174. "many(c,s,i1,i2) - produces the position in s after the longest initial "
  175. "sequence of characters in c in s[i1:i2] but fails if there is none."
  176.  
  177. function{0,1} many(c,s,i,j)
  178.    str_anal( s, i, j )
  179.    if !cnv:tmp_cset(c) then
  180.       runerr(104,c)
  181.    body {
  182.       /*
  183.        * Fail if first character of Arg2[i:j] is not in Arg1.
  184.        */
  185.       if (!Testb(ToAscii(StrLoc(s)[cnv_i-1]), c)) {
  186.          fail;
  187.      }
  188.       /*
  189.        * Move i along Arg2[i:j] until a character that is not in Arg1 is found
  190.        *  or the end of the string is reached.
  191.        */
  192.       cnv_i++;
  193.       while (cnv_i < cnv_j) {
  194.          if (!Testb(ToAscii(StrLoc(s)[cnv_i-1]), c))
  195.             break;
  196.          cnv_i++;
  197.          }
  198.       /*
  199.        * Return the position of the first character not in c.
  200.        */
  201.       return C_integer cnv_i;
  202.       }
  203. end
  204.  
  205.  
  206. "match(s1,s2,i1,i2) - produces i1+*s1 if s1==s2[i1+:*s1], but fails otherwise."
  207.  
  208. function{0,1} match(s1,s2,i,j)
  209.    str_anal( s2, i, j )
  210.    if !cnv:tmp_string(s1) then
  211.       runerr(103,s1)
  212.    body {
  213.       char *str1, *str2;
  214.  
  215.       /*
  216.        * Cannot match unless s2[i:j] is as long as s1.
  217.        */
  218.       if (cnv_j - cnv_i < StrLen(s1))
  219.          fail;
  220.  
  221.       /*
  222.        * Compare s1 with s2[i:j] for *s1 characters; fail if an
  223.        *  inequality is found.
  224.        */
  225.       str1 = StrLoc(s1);
  226.       str2 = StrLoc(s2) + cnv_i - 1;
  227.       for (cnv_j = StrLen(s1); cnv_j > 0; cnv_j--)
  228.          if (*str1++ != *str2++)
  229.             fail;
  230.  
  231.       /*
  232.        * Return position of end of matched string in s2.
  233.        */
  234.       return C_integer cnv_i + StrLen(s1);
  235.       }
  236. end
  237.  
  238.  
  239. "upto(c,s,i1,i2) - generates the sequence of integer positions in s up to a "
  240. "character in c in s[i2:i2], but fails if there is no such position."
  241.  
  242. function{*} upto(c,s,i,j)
  243.    str_anal( s, i, j )
  244.    if !cnv:tmp_cset(c) then
  245.       runerr(104,c)
  246.    body {
  247.       C_integer tmp;
  248.  
  249.       /*
  250.        * Look through s[i:j] and suspend position of each occurrence of
  251.        * of a character in c.
  252.        */
  253.       while (cnv_i < cnv_j) {
  254.          tmp = (C_integer)ToAscii(StrLoc(s)[cnv_i-1]);
  255.          if (Testb(tmp, c)) {
  256.             suspend C_integer cnv_i;
  257.             }
  258.          cnv_i++;
  259.          }
  260.       /*
  261.        * Eventually fail.
  262.        */
  263.       fail;
  264.       }
  265. end
  266.